home *** CD-ROM | disk | FTP | other *** search
/ L' Effet Pommier 3 / L'Effet Pommier - Volume 03.iso / Programmation / Alpha ƒ / Tcl / SystemCode / sendURL.tcl < prev    next >
Encoding:
Text File  |  1995-11-15  |  1.6 KB  |  46 lines  |  [TEXT/ALFA]
  1. # (WTP 7/30/95) Slightly improved 'sendURL'.
  2. # By accepting a text arg, this can now be used to make sendURL 
  3. # hypertext links (useful for "mailto" links in documentation, f'rinstance) 
  4. #===============================================================================
  5. set htmlEventSuiteIDs(MOSS) {WWW!}
  6. proc sendUrl {{text {}}} {
  7.         if {$text == {}} { set text [getSelect] }
  8.          if {[string length $text] == 0} { return }
  9.  
  10.         global htmlBrowserPath htmlEventSuiteIDs
  11.         if {![info exists htmlBrowserPath] || [catch {set sig [getFileSig $htmlBrowserPath]}]} {
  12.                 if {[catch {addAppPath "HTML Browser" htmlBrowserPath}]} {
  13.                         alertnote "You must choose an HTML browser"
  14.                         return
  15.                 }
  16.                 set sig [getFileSig $htmlBrowserPath] 
  17.         }
  18.         
  19.         set name [checkRunning "HTML Browser" $sig htmlBrowserPath]
  20.         if {![string length $name]} {
  21.                 alertnote "Couldn't run HTML browser"
  22.                 return
  23.         }
  24.  
  25.         if {![info exists htmlEventSuiteIDs($sig)]} {
  26.                 alertnote "Can't send URLs to this HTML browser"
  27.                 return
  28.         }
  29.         set suite $htmlEventSuiteIDs($sig)
  30.  
  31.         AEBuild "'${sig}'" $suite {OURL} {----} "╥$text╙"
  32.         switchTo $name
  33. }
  34.  
  35.  
  36. proc expandURL {} {
  37.     set pos [getPos]
  38.     set beg [lineStart $pos]
  39.     if {[string length [set whe [search -s -n -f 1 -r 1 -i 1 -m 0 -l [nextLineStart $pos] {[a-zA-Z0-9]+://[a-zA-Z/._0-9~-]+} $beg]]]} {
  40.         if {($pos >= [lindex $whe 0]) && ($pos < [lindex $whe 1])} {
  41.             eval select $whe
  42.             return $whe
  43.         }
  44.     }
  45. }
  46.